﻿Imports System.Xml
Public Class Fio
    Public Function PSToPageSettings(ByRef pSD As PageSetupDialog, ByRef PInfo As BServer.FBillPrintCFG) As Boolean
        Try
            SControl._Base_GetBillPrintConfig(UInfo.FSession, "Property", PInfo, "")
            Dim ps As New System.Drawing.Printing.PageSettings
            '--打印机
            If PInfo.FPrinterName.Trim <> String.Empty Then
                ps.PrinterSettings.PrinterName = PInfo.FPrinterName
            End If
            '--纸张名称
            'Dim pz As New Printing.PaperSize() With {.PaperName = PInfo.FPaperName}
            '--纸张方向
            If PInfo.FPaperDirect = "H" Then
                ps.Landscape = True
            Else
                ps.Landscape = False
            End If
            '--纸张赋值
            'ps.PaperSize = pz
            '--边距
            ps.Margins = New System.Drawing.Printing.Margins With {.Bottom = PInfo.FMarginB, .Left = PInfo.FMarginL, .Right = PInfo.FMarginR, .Top = PInfo.FMarginT}
            pSD.EnableMetric = True
            pSD.AllowPaper = False
            pSD.PageSettings = ps
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

    '---------文件操作类
    Private Ccontrol As New Cryp
    Public Function HzTopy(ByVal mystr As String) As String
        Dim i As Integer
        Dim J As Integer
        Dim Pstr As String = String.Empty
        Dim Py As String = String.Empty
        Dim k As Integer = Nothing
        Try
            k = Len(mystr)
            For J = 1 To k
                i = Asc(Mid(mystr, J, 1))
                Select Case i
                    Case -20319 To -20284 : Py = "A"
                    Case -20283 To -19776 : Py = "B"
                    Case -19775 To -19219 : Py = "C"
                    Case -19218 To -18711 : Py = "D"
                    Case -18710 To -18527 : Py = "E"
                    Case -18526 To -18240 : Py = "F"
                    Case -18239 To -17923 : Py = "G"
                    Case -17922 To -17418 : Py = "H"
                    Case -17417 To -16475 : Py = "J"
                    Case -16474 To -16213 : Py = "K"
                    Case -16212 To -15641 : Py = "L"
                    Case -15640 To -15166 : Py = "M"
                    Case -15165 To -14923 : Py = "N"
                    Case -14922 To -14915 : Py = "O"
                    Case -14914 To -14631 : Py = "P"
                    Case -14630 To -14150 : Py = "Q"
                    Case -14149 To -14091 : Py = "R"
                    Case -14090 To -13319 : Py = "S"
                    Case -13318 To -12839 : Py = "T"
                    Case -12838 To -12557 : Py = "W"
                    Case -12556 To -11848 : Py = "X"
                    Case -11847 To -11056 : Py = "Y"
                    Case -11055 To -10247 : Py = "Z"
                    Case Else : Py = CStr(Chr(i))
                End Select
                Pstr = Pstr & Py
            Next
            HzTopy = Pstr
        Catch ex As Exception
            Return String.Empty
        End Try
    End Function


#Region "人民币大写"
    '数字转成人民币大写
    Public Function MoneyToUpper(ByVal FMoney As Double) As String
        If FMoney = 0 Then
            Return "零元整"
        End If
        '--负号
        Dim FMSign As String = ""
        If CDbl(FMoney) < 0 Then
            FMoney = Math.Abs(FMoney)
            FMSign = "负"
        End If

        Dim FBigENum As String() = Split("零,壹,贰,叁,肆,伍,陆,柒,捌,玖", ",")
        Dim FBigUnit As String() = Split(",拾,佰,仟,万,拾,佰,仟,亿,拾,佰,仟", ",")

        Dim xx As Integer
        '--小数部分
        Dim FDec As Integer
        '--整数部分
        Dim FInt As Integer = Int(FMoney)
        '--临时变量
        Dim tmpd As Integer

        Dim strResult As String = ""
        Dim strResult1 As String = ""
        Dim tmpResult As String

        Dim zeroflag As Boolean = False
        Dim wflag As Boolean = False
        Dim yflag As Boolean = False
        If FInt > FMoney Then
            FInt = FInt - 1
        End If

        FDec = CInt((FMoney - FInt) * 100)

        '处理角、分   
        If FDec <> 0 Then
            tmpd = FDec Mod 10
            FDec = Int(FDec / 10)

            If tmpd <> 0 Then
                strResult = FBigENum(Int(tmpd)) & "分"
            End If

            If FDec <> 0 Then
                strResult = String.Format("{0}角{1}", FBigENum(Int(FDec)), strResult)
            Else
                If FInt <> 0 Then
                    strResult = "零" & strResult
                End If
            End If
        Else
            strResult = "整"
        End If

        Dim tt As String
        tmpd = Len(CStr(FInt))
        For xx = 1 To Int(tmpd)
            tt = Mid(CStr(FInt), Int(tmpd) - xx + 1, 1)

            If CDbl(tt) <> 0 Then
                tmpResult = FBigENum(Int(tt)) & FBigUnit(xx - 1)
                zeroflag = False

                If xx = 5 Then
                    wflag = True
                End If

                If xx = 9 Then
                    yflag = True
                End If

                If xx > 5 And xx < 9 Then
                    If Not wflag Then
                        tmpResult = tmpResult & "万"
                        wflag = True
                    End If
                End If

                If xx > 9 Then
                    If Not yflag Then
                        tmpResult = tmpResult & "亿"
                        yflag = True
                    End If
                End If

                strResult1 = tmpResult & strResult1
            Else
                If Not zeroflag Then
                    strResult1 = "零" & strResult1
                    zeroflag = True
                End If
            End If
        Next

        If Right(strResult1, 1) = "零" Then
            strResult1 = Left(strResult1, Len(strResult1) - 1)
        End If

        If Len(strResult1) <> 0 Then
            If Trim(FMSign) <> String.Empty Then
                MoneyToUpper = String.Format("负{0}元{1}", strResult1, strResult)
            Else
                MoneyToUpper = String.Format("{0}元{1}", strResult1, strResult)
            End If

        Else
            If Trim(FMSign) <> String.Empty Then
                MoneyToUpper = FMSign & strResult
            Else
                MoneyToUpper = strResult
            End If

        End If
    End Function

#End Region


    Public Function ReadXML(ByVal fpath As String, ByVal fnode As String, ByRef rtn As String, Optional ByRef ErrString As String = "") As Boolean
        Try
            If Trim(fpath) = String.Empty Or Trim(fnode) = String.Empty Then
                ErrString = "路径或节点名不能为空"
                Return False
            End If
            '------开始读取
            Dim xmldoc As New XmlDocument()
            xmldoc.Load(fpath)
            Dim xmlnode As XmlNode = xmldoc.SelectSingleNode("ROOT")
            rtn = xmlnode.SelectSingleNode(fnode).InnerText
            Return True
        Catch ex As Exception
            ErrString = ex.Message
            Return False
        End Try
    End Function

    Public Function WriteXML(ByVal Fpath As String, ByVal fnode As String, ByVal Fcont As String, Optional ByRef ErrString As String = "") As Boolean
        Try
            If Trim(Fpath) = String.Empty Or Trim(fnode) = String.Empty Then
                ErrString = "路径或节点名不能为空!"
                Return False
            End If
            '----开始写入
            Dim xmldoc As New XmlDocument
            xmldoc.Load(Fpath)
            Dim xmlnode As XmlNode = xmldoc.SelectSingleNode("ROOT")
            '----如果没有节点则新增一个
            If xmlnode.SelectSingleNode(fnode) Is Nothing Then
                Dim xe As XmlElement = xmldoc.CreateElement(fnode)
                xmlnode.AppendChild(xe)
            End If
            'If xmlnode.SelectSingleNode(fnode).Name <> Trim(fnode) Then
            '    Dim xe As XmlElement = xmldoc.CreateElement(fnode)
            '    xmlnode.AppendChild(xe)
            'End If
            '----写节点innertext
            xmlnode.SelectSingleNode(fnode).InnerText = Fcont
            xmldoc.Save(Fpath)
            Return True
        Catch ex As Exception
            ErrString = ex.Message
            Return False
        End Try
    End Function
    Public Function CreateXMLCfg(ByVal fpath As String, Optional ByRef ErrString As String = "") As Boolean
        Try
            If Trim(fpath) = String.Empty Then
                ErrString = "路径不能为空!"
                Return False
            End If
            '-----建立

            Dim xmlwr As New XmlTextWriter(fpath, System.Text.Encoding.UTF8) With {.Formatting = System.Xml.Formatting.Indented}
            xmlwr.WriteRaw("<?xml version=""1.0"" encoding=""utf-8"" ?>")
            xmlwr.WriteStartElement("ROOT")
            xmlwr.WriteEndElement()
            xmlwr.Flush()
            xmlwr.Close()

            Dim xmldoc As New XmlDocument
            xmldoc.Load(fpath)
            Dim root As XmlNode = xmldoc.SelectSingleNode("ROOT")
            Dim xe As XmlElement
            xe = xmldoc.CreateElement("USER")
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("PSW")
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("SAVEPSW")
            xe.InnerText = "N"
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("ETH")
            xe.InnerText = "192.168.1.238"
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("WAN")
            xe.InnerText = "60.18.250.78"
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("DBNAME")
            xe.InnerText = Ccontrol.desencryp("TLHX_OA", "crypt011")
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("DBUSER")
            xe.InnerText = Ccontrol.desencryp("tlhxoa", "crypt011")
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("DBPASS")
            xe.InnerText = Ccontrol.desencryp("fz*TP_ym", "crypt011")
            root.AppendChild(xe)
            xe = xmldoc.CreateElement("STYLE")
            xe.InnerText = "0"
            root.AppendChild(xe)
            xmldoc.Save(fpath)
            xmldoc = Nothing
            root = Nothing
            xe = Nothing
            Return True
        Catch ex As Exception
            ErrString = ex.Message
            Return False
        End Try
    End Function
    Public Function cvN(ByVal s As Object) As Object
        If IsDBNull(s) Then
            Return Nothing
        Else
            Return s
        End If
    End Function

    Private Function Compress(ByVal Fdata As Byte()) As Byte()
        Dim ms As New System.IO.MemoryStream(Fdata)
        Dim zipStream As New System.IO.Compression.GZipStream(ms, IO.Compression.CompressionMode.Compress, True)
        zipStream.Write(Fdata, 0, Fdata.Length)
        zipStream.Close()
        Return ms.ToArray
    End Function

    Public Function CalcInch(ByVal f1 As Double) As Integer
        If f1 = Nothing Then
            Return 0
        End If
        Dim fs As Integer = f1 / 25.4 * 100
        Return fs
    End Function
#Region "DATAGRIDVIEW导出EXCEL"
    Public Function ExpertToXls(ByVal x As DataGridView) As Boolean '导出到Excel函数
        Try
            If x.Rows.Count <= 0 Then '判断记录数,如果没有记录就退出
                MessageBox.Show("没有记录可以导出", "没有可以导出的项目", MessageBoxButtons.OK, MessageBoxIcon.Information)
                Return False
            Else '如果有记录就导出到Excel
                Dim xx As Object : Dim yy As Object
                xx = CreateObject("Excel.Application") '创建Excel对象
                yy = xx.workbooks.add()
                Dim i As Integer, u As Integer = 0, v As Integer = 0 '定义循环变量,行列变量
                For i = 1 To x.Columns.Count '把表头写入Excel
                    yy.worksheets(1).cells(1, i) = x.Columns(i - 1).HeaderCell.Value
                Next
                Dim str(x.Rows.Count - 1, x.Columns.Count - 1) '定义一个二维数组
                For u = 1 To x.Rows.Count '行循环
                    For v = 1 To x.Columns.Count '列循环
                        If x.Item(v - 1, u - 1).Value.GetType.ToString <> "System.Guid" Then
                            str(u - 1, v - 1) = x.Item(v - 1, u - 1).Value
                        Else
                            str(u - 1, v - 1) = x.Item(v - 1, u - 1).Value.ToString
                        End If
                    Next
                Next
                yy.worksheets(1).range("A2").Resize(x.Rows.Count, x.Columns.Count).Value = str '把数组一起写入Excel
                yy.worksheets(1).Cells.EntireColumn.AutoFit() '自动调整Excel列
                ' yy.worksheets(1).name = x.TopLeftHeaderCell.Value.ToString '表标题写入作为Excel工作表名称
                xx.visible = True '设置Excel可见
                yy = Nothing '销毁组建释放资源
                xx = Nothing '销毁组建释放资源
            End If
            Return True
        Catch ex As Exception '错误处理
            MessageBox.Show(Err.Description.ToString, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error) '出错提示
            Return False
        End Try
    End Function
#End Region
#Region "还原DATASET"
    Public Function DsRestore(ByRef ds As DataSet, ByVal FData As Byte()) As Boolean
        Try
            'Dim ms As New System.IO.MemoryStream(DeCompress(FData))
            Dim ms As New System.IO.MemoryStream(FData)
            Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
            Dim nds As DataSetSurrogate = bf.Deserialize(ms)
            ds = nds.ConvertToDataSet()
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function
#End Region
#Region "转换序列化DATASET"
    Public Function CvtDs(ByRef ds As Data.DataSet) As Byte()
        Dim nds As DataSetSurrogate = New DataSetSurrogate(ds)
        Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
        Dim MS As New System.IO.MemoryStream
        bf.Serialize(MS, nds)
        'Return Compress(MS.ToArray)
        Return MS.ToArray
    End Function
#End Region
#Region "解压数据"
    Private Shared Function DeCompress(ByVal FData As Byte()) As Byte()
        Try
            Dim ms As New System.IO.MemoryStream(FData)
            Dim zs As New System.IO.Compression.GZipStream(ms, IO.Compression.CompressionMode.Decompress)
            Dim nms As New System.IO.MemoryStream
            Dim FBytes As Byte() = New Byte(40960) {}
            Dim n As Integer = zs.Read(FBytes, 0, FBytes.Length)
            nms.Write(FBytes, 0, n)
            zs.Close()
            Return nms.ToArray
        Catch ex As Exception
            Return Nothing
        End Try
    End Function
#End Region
End Class
